home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / personalpaint7.lha / PPaint / Rexx / CircleText.pprx < prev    next >
Encoding:
Text File  |  1997-04-19  |  12.1 KB  |  501 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: CircleText.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script draws a circular vector text.
  7.  
  8.  This is a "tool macro": the mouse can be used to define a circle; when
  9.  the mouse button is released, a settings requester is displayed. The
  10.  settings include: font, text string, text size, antialiasing, etc.
  11.  
  12.  If a single point (pixel) is selected instead of an area, the previous
  13.  circle coordinates remain in use. Other parameters allow the user
  14.  to adjust the appearance of the text.
  15.  
  16.  The text string specified in the settings requester may contain color
  17.  control sequences, in the format "Esc[3#m" or "[#]", where # is a pen
  18.  number (0 .. 256). The default (initial) color is the current foreground
  19.  color.
  20.  
  21.  By specifying a Frame setting greater than 1, it is possible to
  22.  create an animation sequence in which the circular text rotates
  23.  (the greater the number of frames, the smoother the rotation).
  24. */
  25.  
  26. /** DEU
  27.  Dieses Skript dient zur Ausrichtung eines Vektortexts an einer
  28.  Kreislinie.
  29.  
  30.  Dies ist ein sog. "Tool-Makro", d.h. zunächst wird mit Hilfe der Maus
  31.  der Kreis erstellt. Sobald die Maustaste losgelassen wird, öffnet
  32.  sich ein Dialogfenster zur Festlegung von Einstellungen für Font,
  33.  Textstring, Zeichengröße, Kantenglättung, usw.
  34.  
  35.  Wird anstelle eine Bereichs lediglich ein einzelner Punkt selektiert,
  36.  bleiben die vorherigen Kreiskoordinaten erhalten. Andere Parameter
  37.  ermöglichen dem Benutzer u.a. die Festlegung des Erscheinungsbildes
  38.  für den Text.
  39.  
  40.  Hinweis: Der im Einstellungen-Dialogfenster festgelegte Textstring kann
  41.  auch mit Steuerzeichen zur Aktivierung einer bestimmten Farbe versehen
  42.  werden. Diese müssen im Format "Esc[3#m]" oder "[#]" vorliegen, wobei das
  43.  Rautenzeichen # die Stiftnummer (0...256) angibt. Standardmäßig ist die
  44.  aktuelle Vordergrundfarbe eingestellt.
  45. */
  46.  
  47. IF ARG(1, EXISTS) THEN
  48.     PARSE ARG PPPORT button x0 y0 .
  49. ELSE
  50.     EXIT 0  /* macro execution only */
  51.  
  52. ADDRESS VALUE PPPORT
  53. OPTIONS RESULTS
  54. OPTIONS FAILAT 10000
  55.  
  56. Get 'LANG'
  57. IF RESULT = 1 THEN DO        /* Deutsch */
  58.     txt_title_zone    = "Kreisdefinition"
  59.     txt_gad_x0        = "Zentrum _X:"
  60.     txt_gad_y0        = "Zentrum _Y:"
  61.     txt_gad_radius    = "_Radius:"
  62.     txt_title_set     = "Kreistext-Einstellungen"
  63.     txt_gad_font      = "_Font:"
  64.     txt_gad_text      = "_Text:"
  65.     txt_string_text   = "Dieser Text verläuft im Kreis. "
  66.     txt_gad_height    = "_Höhe:"
  67.     txt_gad_frames    = "_Einzelbilder:"
  68.     txt_gad_sangle    = "A_nfangswinkel:"
  69.     txt_gad_aalias    = "_Kantenglättung:"
  70.     txt_gad_aalias0   = "Keine"
  71.     txt_gad_aalias1   = "Schwach"
  72.     txt_gad_aalias2   = "Mittel"
  73.     txt_gad_aalias3   = "Stark"
  74.     txt_err_nofonts   = "Vectorfonts nicht auffindbar"
  75.     txt_err_procss    = "Fehler bei Bildbearbeitung: "
  76.     txt_err_small     = "Kreis ist zu klein"
  77.     txt_err_nomem     = "Zu wenig Speicher"
  78.     txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
  79. END
  80. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  81.     txt_title_zone    = "Definizione cerchio"
  82.     txt_gad_x0        = "Centro _X:"
  83.     txt_gad_y0        = "Centro _Y:"
  84.     txt_gad_radius    = "_Raggio:"
  85.     txt_title_set     = "Parametri testo"
  86.     txt_gad_font      = "_Font:"
  87.     txt_gad_text      = "_Testo:"
  88.     txt_string_text   = "Questo è un testo circolare. "
  89.     txt_gad_height    = "Alte_zza:"
  90.     txt_gad_frames    = "Fotogra_mmi:"
  91.     txt_gad_sangle    = "Ang_olo iniziale:"
  92.     txt_gad_aalias    = "Antialia_s:"
  93.     txt_gad_aalias0   = "Nessuno"
  94.     txt_gad_aalias1   = "Basso"
  95.     txt_gad_aalias2   = "Medio"
  96.     txt_gad_aalias3   = "Alto"
  97.     txt_err_nofonts   = "Non vi sono font vettoriali"
  98.     txt_err_procss    = "Errore elaborazione immagine: "
  99.     txt_err_small     = "Il cerchio definito è troppo piccolo"
  100.     txt_err_nomem     = "Memoria insufficiente"
  101.     txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
  102. END
  103. ELSE DO                /* English */
  104.     txt_title_zone    = "Circle Definition"
  105.     txt_gad_x0        = "Center _X:"
  106.     txt_gad_y0        = "Center _Y:"
  107.     txt_gad_radius    = "_Radius:"
  108.     txt_title_set     = "Circle Text Settings"
  109.     txt_gad_font      = "_Font:"
  110.     txt_gad_text      = "_Text:"
  111.     txt_string_text   = "This is a circular text. "
  112.     txt_gad_height    = "_Height:"
  113.     txt_gad_frames    = "Fra_mes:"
  114.     txt_gad_sangle    = "Start _Angle:"
  115.     txt_gad_aalias    = "A_ntialias:"
  116.     txt_gad_aalias0   = "None"
  117.     txt_gad_aalias1   = "Low"
  118.     txt_gad_aalias2   = "Medium"
  119.     txt_gad_aalias3   = "High"
  120.     txt_err_nofonts   = "Vector fonts not found"
  121.     txt_err_procss    = "Image processing error: "
  122.     txt_err_small     = "The circle is too small"
  123.     txt_err_nomem     = "Not enough memory"
  124.     txt_err_oldclient = "This script requires a newer_version of Personal Paint"
  125. END
  126.  
  127. Version 'REXX'
  128. IF RESULT < 7 THEN DO
  129.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  130.     EXIT 10
  131. END
  132.  
  133. /* Circle Definition */
  134.  
  135. GetCurrentBrush
  136. savebsh = RESULT
  137. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  138.  
  139. prev_xp = x0
  140. prev_yp = y0
  141. drawn = 0
  142.  
  143. DO FOREVER
  144.     GetMousePosition
  145.     PARSE VAR RESULT xp yp .
  146.  
  147.     IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  148.         IF drawn THEN
  149.             Undo
  150.         GetDistance x0 y0 xp yp 'IMAGERATIO'
  151.         radius = RESULT
  152.         DrawCircle x0 y0 'RADIUSX' radius
  153.  
  154.         prev_xp = xp
  155.         prev_yp = yp
  156.         drawn = 1
  157.     END
  158.     ELSE WaitForEvent
  159.  
  160.     GetMouseButton
  161.     IF RESULT ~= button THEN
  162.         LEAVE
  163. END
  164.  
  165. Undo
  166. SetCurrentBrush savebsh
  167.  
  168.  
  169. FreeBrush
  170. IF RC ~= 0 THEN
  171.     EXIT RC
  172.  
  173. /* Setting Requester */
  174.  
  175. def_font_path = "FONTS:"
  176. max_text_size = 8000
  177.  
  178. font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
  179.  
  180.  
  181. ftot = 0
  182. vftfname = 'ENV:PP_VectorFonts'
  183. IF ~OPEN(fexists, vftfname) THEN DO
  184.     ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
  185.     ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
  186.     IF RC = 0 THEN DO
  187.         ADDRESS COMMAND 'Delete >NIL: 'vftfname
  188.         ADDRESS COMMAND 'Copy >NIL: 'vftfname'.s' vftfname
  189.         ADDRESS COMMAND 'Delete >NIL: 'vftfname'.s'
  190.     END
  191. END
  192. ELSE CALL CLOSE(fexists)
  193.  
  194. IF OPEN('listfile', vftfname) THEN DO
  195.     DO FOREVER
  196.         fline = READLN('listfile')
  197.         IF EOF('listfile') THEN BREAK
  198.         ftot = ftot + 1
  199.         fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
  200.     END
  201.     CALL CLOSE('listfile')
  202. END
  203.  
  204. IF ftot = 0 THEN DO
  205.     RequestNotify 'PROMPT "'txt_err_nofonts'"'
  206.     EXIT 10
  207. END
  208.  
  209.  
  210. IF radius < 2 THEN DO        /* simple click */
  211.     lastpar  = LoadSet('LastParams', '0 0 100')
  212.     PARSE VAR lastpar x0 y0 radius .
  213.     Request '"'txt_title_zone'" ' ||,
  214.             '"INTSTR = ""'txt_gad_x0'"", 0, 32000, 'x0' ' ||,
  215.              'INTSTR = ""'txt_gad_y0'"", 0, 32000, 'y0' ' ||,
  216.              'INTSTR = ""'txt_gad_radius'"", 1, 32000, 'radius' "'
  217.     IF RC ~= 0 THEN
  218.         EXIT RC
  219.     x0 = RESULT.1
  220.     y0 = RESULT.2
  221.     radius = RESULT.3
  222. END
  223.  
  224.  
  225. fntnum  = LoadSet('Font', 0)
  226. text    = LoadSet('Text', txt_string_text)
  227. height  = LoadSet('Height', 50)
  228. angle   = LoadSet('StartAngle', 0)
  229. aalias  = LoadSet('Antialias', 0)
  230. frames  = LoadSet('Frames', 0)
  231. last_height  = height
  232.  
  233. req = '"LIST = ""'txt_gad_font'"", 'ftot', 'fntnum', 20, 7'
  234. DO f = 1 TO ftot
  235.     req = req || ', ""' || fontname.f || '""'
  236. END
  237.  
  238. req = req ||,
  239.      ' VSPACE = 2 ' ||,
  240.       'STRING = ""'txt_gad_text'"", 'max_text_size', ""'text'"" ' ||,
  241.       'INTSTR = ""'txt_gad_height'"", 1, 32000, 'height' ' ||,
  242.       'INTSTR = ""'txt_gad_frames'"", 0, 32000, 'frames' ' ||,
  243.       'VSPACE = 2 ' ||,
  244.       'SLIDE = ""'txt_gad_sangle'"", -360, 360, 'angle' ' ||,
  245.       'VSPACE = 2 ' ||,
  246.         'CYCLE = ""'txt_gad_aalias'"", 4, 'aalias', ""'txt_gad_aalias0'"", ""'txt_gad_aalias1'"", ""'txt_gad_aalias2'"", ""'txt_gad_aalias3'"" ' ||,
  247.       'VSPACE = 2 "'
  248.  
  249. LockGUI
  250. Request 'RESIZE COMPACT "'txt_title_set'" 'req
  251. IF RC = 0 THEN DO
  252.     fntnum  = RESULT.1 + 1
  253.     text    = RESULT.2
  254.     height  = RESULT.3
  255.     frames  = RESULT.4
  256.     angle   = RESULT.5
  257.     aalias  = RESULT.6
  258.  
  259.     CALL SaveSet('Font', fntnum - 1)        /* setting persistence */
  260.     CALL SaveSet('Text', text)
  261.     CALL SaveSet('Height', height)
  262.     CALL SaveSet('StartAngle', angle)
  263.     CALL SaveSet('Antialias', aalias)
  264.     CALL SaveSet('Frames', frames)
  265.     CALL SaveSet('LastParams', x0 y0 radius)
  266.  
  267.     IF radius < 1 THEN DO
  268.         RequestNotify 'PROMPT "'txt_err_small'"'
  269.         len = 0
  270.     END
  271.  
  272.     angle = angle * 1000
  273.     IF angle < 0 THEN
  274.         angle = 360000 + angle
  275.     IF angle >= 360000 THEN
  276.         angle = angle - 360000
  277.  
  278.     GetPen 'FOREGROUND'
  279.     pen = RESULT
  280.     savepen = pen
  281.     SIGNAL ON Break_C
  282.  
  283.     tchar. = ''
  284.     tpen. = pen
  285.     tchars = ''
  286.     len = ParseText(text, pen)
  287.     totsize = 0
  288.  
  289.     last_metrics = LoadSet('Metrics', '')
  290.     last_tchars = LoadSet('TxChars', '')
  291.  
  292.     IF height == last_height & tchars == last_tchars THEN DO
  293.         DO c = 1 TO len
  294.             addx = WORD(last_metrics, c)
  295.             totsize = totsize + addx
  296.             size.c = addx
  297.         END
  298.     END
  299.     ELSE DO
  300.         metrics = ''
  301.         DO c = 1 TO len
  302.             nextc = c + 1
  303.             VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height
  304.             IF RC = 0 THEN DO
  305.                 PARSE VAR RESULT addx .
  306.                 totsize = totsize + addx
  307.                 size.c = addx
  308.                 metrics = metrics addx
  309.             END
  310.             ELSE DO
  311.                 RequestNotify 'PROMPT "'txt_err_nomem'"'
  312.                 EXIT 0
  313.             END
  314.         END
  315.         CALL SaveSet('Metrics', metrics)
  316.         CALL SaveSet('TxChars', tchars)
  317.     END
  318.     last = len + 1
  319.     size.last = 0
  320.  
  321.     GetImageAttributes 'DPIX'
  322.     dpix = RESULT
  323.     GetImageAttributes 'DPIY'
  324.     imgratio = dpix / RESULT
  325.     rx = radius
  326.     ry = TRUNC(radius / imgratio + 0.5)
  327.  
  328.     IF frames < 1 THEN
  329.         frames = 1
  330.     IF frames > 1 THEN
  331.         AddFrames 'FRAMES' frames
  332.     start_angle = angle
  333.     angle_step = 360000 % frames
  334.  
  335.     DO f = 1 TO frames
  336.         angle = start_angle
  337.         DO c = 1 TO len
  338.             GetEllipsePoint x0 y0 rx ry angle
  339.             PARSE VAR RESULT px py .
  340.  
  341.             nextc = c + 1
  342.             VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height' ANGLE 'angle' ANTIALIAS 'aalias
  343.             IF RC = 0 THEN DO
  344.                 PARSE VAR RESULT . . handlex handley .
  345.  
  346.                 SetBrushAttributes 'HANDLEX 'handlex' HANDLEY 'handley
  347.                 SetPaintMode 'COLOR'
  348.                 SetPen 'FOREGROUND' tpen.c
  349.  
  350.                 IF aalias > 0 THEN DO
  351.                     Process 'IMAGE BRUSHMODE X0 'px' Y0 'py' FILTER "Brush Alpha Channel (Single)" NOFS'
  352.                     IF RC ~= 0 THEN DO
  353.                         IF RC ~= 5 THEN
  354.                             RequestNotify 'PROMPT "'txt_err_procss || RC'"'
  355.                         LEAVE
  356.                     END
  357.                 END
  358.                 ELSE PutBrush px py
  359.  
  360.                 angle = angle + TRUNC((size.c + size.nextc) / 2 / totsize * 360000 + 0.5)
  361.                 IF angle >= 360000 THEN
  362.                     angle = angle - 360000
  363.             END
  364.         END
  365.         IF frames > 1 THEN DO
  366.             start_angle = start_angle + angle_step
  367.             IF start_angle >= 360000 THEN
  368.                 start_angle = start_angle - 360000
  369.             SetFramePosition 'NEXT'
  370.         END
  371.     END
  372.     SetPen 'FOREGROUND' savepen
  373.     FreeBrush 'FORCE'
  374. END
  375. UnlockGUI
  376.  
  377. EXIT 0
  378.  
  379.  
  380.  
  381.  
  382. ParseText: PROCEDURE EXPOSE tchar. tpen. tchars
  383.  
  384.     tstring = ARG(1)
  385.     tpn = ARG(2)
  386.     tlen = LENGTH(tstring)
  387.     tchars = ''
  388.     tpos = 1
  389.     tnum = 0
  390.  
  391.     DO UNTIL tpos > tlen
  392.         td = SUBSTR(tstring, tpos, 1)
  393.         tnewpen = ''
  394.         IF td = '[' THEN DO    /* [###] */
  395.             tnewpos = tpos + 1
  396.             IF SUBSTR(tstring, tnewpos, 1) = '[' THEN
  397.                 tpos = tpos + 1
  398.             ELSE DO
  399.                 DO FOREVER
  400.                     tc = SUBSTR(tstring, tnewpos, 1)
  401.                     IF tc < '0' | tc > '9' THEN
  402.                         LEAVE
  403.                     tnewpen = tnewpen || tc
  404.                     tnewpos = tnewpos + 1
  405.                 END
  406.             END
  407.         END
  408.         ELSE IF C2D(td) = 27 THEN DO    /* Esc[3###m */
  409.             IF SUBSTR(tstring, tpos+1, 2) == '[3' THEN DO
  410.                 tnewpos = tpos + 3
  411.                 DO FOREVER
  412.                     tc = SUBSTR(tstring, tnewpos, 1)
  413.                     IF tc < '0' | tc > '9' THEN
  414.                         LEAVE
  415.                     tnewpen = tnewpen || tc
  416.                     tnewpos = tnewpos + 1
  417.                 END
  418.             END
  419.         END
  420.         ELSE IF td = '"' THEN
  421.             td = '""'
  422.  
  423.         IF tnewpen == '' THEN DO
  424.             tnum = tnum + 1
  425.             tchar.tnum = td
  426.             tpen.tnum = tpn
  427.             tchars = tchars || td
  428.             tpos = tpos + 1
  429.         END
  430.         ELSE DO
  431.             tpn = tnewpen
  432.             tpos = tnewpos + 1
  433.         END
  434.     END
  435.  
  436.     RETURN tnum
  437.  
  438.  
  439.  
  440.  
  441. SaveSet: PROCEDURE
  442.     sname = ARG(1)
  443.     val = ARG(2)
  444.  
  445.     IF OPEN('settingfile', 'ENV:PP_CircleTx_'sname, 'W') THEN DO
  446.         CALL WRITECH('settingfile', val)
  447.         CALL CLOSE('settingfile')
  448.     END
  449.  
  450.     RETURN
  451.  
  452.  
  453.  
  454.  
  455. LoadSet: PROCEDURE
  456.     sname = ARG(1)
  457.     def_val = ARG(2)
  458.     IF ARG() > 2 THEN
  459.         global_set = ARG(3)
  460.     ELSE
  461.         global_set = 0
  462.     IF ARG() > 3 THEN
  463.         request_quote = ARG(4)
  464.     ELSE
  465.         request_quote = 1
  466.  
  467.     val = def_val
  468.     IF global_set THEN
  469.         set_fname = 'ENV:'sname
  470.     ELSE
  471.         set_fname = 'ENV:PP_CircleTx_'sname
  472.  
  473.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  474.         val = READCH('settingfile', 65535)
  475.         CALL CLOSE('settingfile')
  476.     END
  477.  
  478.     IF request_quote THEN DO
  479.         /* encode quotes for the Request command ('"' -> '\""') */
  480.         qpos_start = 1
  481.         DO FOREVER
  482.             qpos = INDEX(val, '"', qpos_start)
  483.             IF qpos = 0 THEN BREAK
  484.             val = INSERT('\"', val, qpos-1)
  485.             qpos_start = qpos + 3
  486.         END
  487.     END
  488.  
  489.     RETURN val
  490.  
  491.  
  492.  
  493.  
  494. Break_C:
  495.  
  496.     SetPen 'FOREGROUND' savepen
  497.     FreeBrush 'FORCE'
  498.     UnlockGUI
  499.  
  500.     RETURN
  501.